home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / The_Last_H20903111112007.psc / The Last Hope / frmMain.frm < prev    next >
Text File  |  2007-11-11  |  16KB  |  523 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BackColor       =   &H8000000C&
  4.    BorderStyle     =   4  'Fixed ToolWindow
  5.    Caption         =   "300"
  6.    ClientHeight    =   11160
  7.    ClientLeft      =   45
  8.    ClientTop       =   315
  9.    ClientWidth     =   15270
  10.    Icon            =   "frmMain.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   744
  15.    ScaleMode       =   3  'Pixel
  16.    ScaleWidth      =   1018
  17.    StartUpPosition =   2  'CenterScreen
  18.    Begin VB.PictureBox Picture1 
  19.       AutoRedraw      =   -1  'True
  20.       Height          =   4815
  21.       Left            =   8040
  22.       Picture         =   "frmMain.frx":030A
  23.       ScaleHeight     =   317
  24.       ScaleMode       =   3  'Pixel
  25.       ScaleWidth      =   477
  26.       TabIndex        =   11
  27.       Top             =   9960
  28.       Visible         =   0   'False
  29.       Width           =   7215
  30.    End
  31.    Begin VB.PictureBox picDamage 
  32.       AutoRedraw      =   -1  'True
  33.       AutoSize        =   -1  'True
  34.       BorderStyle     =   0  'None
  35.       Height          =   120
  36.       Left            =   9480
  37.       Picture         =   "frmMain.frx":71184
  38.       ScaleHeight     =   8
  39.       ScaleMode       =   3  'Pixel
  40.       ScaleWidth      =   80
  41.       TabIndex        =   10
  42.       Top             =   8400
  43.       Width           =   1200
  44.    End
  45.    Begin VB.PictureBox picLife 
  46.       AutoRedraw      =   -1  'True
  47.       AutoSize        =   -1  'True
  48.       BorderStyle     =   0  'None
  49.       Height          =   225
  50.       Left            =   9000
  51.       Picture         =   "frmMain.frx":71946
  52.       ScaleHeight     =   15
  53.       ScaleMode       =   3  'Pixel
  54.       ScaleWidth      =   20
  55.       TabIndex        =   9
  56.       Top             =   8280
  57.       Width           =   300
  58.    End
  59.    Begin VB.PictureBox picBkGround 
  60.       AutoRedraw      =   -1  'True
  61.       Height          =   1455
  62.       Left            =   12720
  63.       Picture         =   "frmMain.frx":71D0C
  64.       ScaleHeight     =   1395
  65.       ScaleWidth      =   2475
  66.       TabIndex        =   8
  67.       Top             =   8400
  68.       Visible         =   0   'False
  69.       Width           =   2535
  70.    End
  71.    Begin VB.Timer Timer2 
  72.       Enabled         =   0   'False
  73.       Interval        =   5
  74.       Left            =   12960
  75.       Top             =   6360
  76.    End
  77.    Begin VB.PictureBox maskBang 
  78.       Appearance      =   0  'Flat
  79.       AutoRedraw      =   -1  'True
  80.       AutoSize        =   -1  'True
  81.       BackColor       =   &H80000005&
  82.       BorderStyle     =   0  'None
  83.       ForeColor       =   &H80000008&
  84.       Height          =   750
  85.       Left            =   7080
  86.       Picture         =   "frmMain.frx":15A62A
  87.       ScaleHeight     =   750
  88.       ScaleWidth      =   5250
  89.       TabIndex        =   7
  90.       Top             =   7080
  91.       Visible         =   0   'False
  92.       Width           =   5250
  93.    End
  94.    Begin VB.PictureBox picBang 
  95.       Appearance      =   0  'Flat
  96.       AutoRedraw      =   -1  'True
  97.       AutoSize        =   -1  'True
  98.       BackColor       =   &H80000005&
  99.       BorderStyle     =   0  'None
  100.       ForeColor       =   &H80000008&
  101.       Height          =   750
  102.       Left            =   6720
  103.       Picture         =   "frmMain.frx":1673E6
  104.       ScaleHeight     =   750
  105.       ScaleWidth      =   5250
  106.       TabIndex        =   6
  107.       Top             =   6240
  108.       Visible         =   0   'False
  109.       Width           =   5250
  110.    End
  111.    Begin VB.PictureBox maskAsteroid 
  112.       Appearance      =   0  'Flat
  113.       AutoRedraw      =   -1  'True
  114.       AutoSize        =   -1  'True
  115.       BackColor       =   &H80000005&
  116.       BorderStyle     =   0  'None
  117.       ForeColor       =   &H80000008&
  118.       Height          =   750
  119.       Left            =   6720
  120.       Picture         =   "frmMain.frx":1741A2
  121.       ScaleHeight     =   750
  122.       ScaleWidth      =   7500
  123.       TabIndex        =   5
  124.       Top             =   5280
  125.       Visible         =   0   'False
  126.       Width           =   7500
  127.    End
  128.    Begin VB.PictureBox picAsteroids 
  129.       Appearance      =   0  'Flat
  130.       AutoRedraw      =   -1  'True
  131.       AutoSize        =   -1  'True
  132.       BackColor       =   &H80000005&
  133.       BorderStyle     =   0  'None
  134.       ForeColor       =   &H80000008&
  135.       Height          =   750
  136.       Left            =   6720
  137.       Picture         =   "frmMain.frx":1866DE
  138.       ScaleHeight     =   50
  139.       ScaleMode       =   3  'Pixel
  140.       ScaleWidth      =   500
  141.       TabIndex        =   4
  142.       Top             =   2280
  143.       Visible         =   0   'False
  144.       Width           =   7500
  145.    End
  146.    Begin VB.PictureBox maskFire 
  147.       Appearance      =   0  'Flat
  148.       AutoRedraw      =   -1  'True
  149.       BackColor       =   &H80000005&
  150.       BorderStyle     =   0  'None
  151.       ForeColor       =   &H80000008&
  152.       Height          =   255
  153.       Left            =   13320
  154.       Picture         =   "frmMain.frx":198C1A
  155.       ScaleHeight     =   17
  156.       ScaleMode       =   3  'Pixel
  157.       ScaleWidth      =   28
  158.       TabIndex        =   3
  159.       Top             =   7440
  160.       Visible         =   0   'False
  161.       Width           =   420
  162.    End
  163.    Begin VB.PictureBox picFire 
  164.       AutoRedraw      =   -1  'True
  165.       AutoSize        =   -1  'True
  166.       BorderStyle     =   0  'None
  167.       Height          =   255
  168.       Left            =   12840
  169.       Picture         =   "frmMain.frx":19931C
  170.       ScaleHeight     =   17
  171.       ScaleMode       =   3  'Pixel
  172.       ScaleWidth      =   28
  173.       TabIndex        =   2
  174.       Top             =   7440
  175.       Visible         =   0   'False
  176.       Width           =   420
  177.    End
  178.    Begin VB.Timer Timer1 
  179.       Enabled         =   0   'False
  180.       Interval        =   900
  181.       Left            =   12480
  182.       Top             =   6360
  183.    End
  184.    Begin VB.PictureBox picMask 
  185.       AutoRedraw      =   -1  'True
  186.       AutoSize        =   -1  'True
  187.       BorderStyle     =   0  'None
  188.       Height          =   1860
  189.       Left            =   6720
  190.       Picture         =   "frmMain.frx":1998F2
  191.       ScaleHeight     =   124
  192.       ScaleMode       =   3  'Pixel
  193.       ScaleWidth      =   559
  194.       TabIndex        =   1
  195.       Top             =   0
  196.       Visible         =   0   'False
  197.       Width           =   8385
  198.    End
  199.    Begin VB.PictureBox picShip 
  200.       AutoRedraw      =   -1  'True
  201.       AutoSize        =   -1  'True
  202.       BorderStyle     =   0  'None
  203.       Height          =   1860
  204.       Left            =   6720
  205.       Picture         =   "frmMain.frx":1CC6F4
  206.       ScaleHeight     =   124
  207.       ScaleMode       =   3  'Pixel
  208.       ScaleWidth      =   559
  209.       TabIndex        =   0
  210.       Top             =   3240
  211.       Visible         =   0   'False
  212.       Width           =   8385
  213.    End
  214. End
  215. Attribute VB_Name = "frmMain"
  216. Attribute VB_GlobalNameSpace = False
  217. Attribute VB_Creatable = False
  218. Attribute VB_PredeclaredId = True
  219. Attribute VB_Exposed = False
  220. Option Explicit
  221. 'FOR EXPERIENCED GAME PROGRAMMERS IN VB6:-
  222. 'Please Read the Advanced section under ReadMe.txt file included with this Game
  223. 'This is my first game in VB or infact in any PG Language
  224. 'Its not the final release of this game as I plan to extend it
  225. 'Game is updated with the help of two timers 1 and 2
  226.  
  227. 'Declarations to the Classes
  228. Dim Fire As Weapon
  229. Dim Asteroid As CAsteroids
  230. Dim Explosion As cCollision
  231. Dim Goody As cGoody
  232.  
  233. 'Gameplay variables
  234. Dim Keypressed As Boolean
  235. Dim TimeVal As Integer
  236.  
  237. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  238. Static Cheatcode As String
  239. If isShipDestroyed Then Exit Sub
  240. 'Control fires and space releases Bomb
  241.     If KeyCode = vbKeyControl Then
  242.         If Not Keypressed Then
  243.             If Score > 10 Then Score = Score - 20
  244.             Fire.CreateFire
  245.             Keypressed = True
  246.         End If
  247.     ElseIf KeyCode = vbKeySpace Then
  248.         If BombNumber Then Destroyall
  249.     ElseIf KeyCode = 192 And CheatOn Then DoCheats
  250. End If
  251. End Sub
  252.  
  253. Private Sub Form_KeyPress(KeyAscii As Integer)
  254. If KeyAscii = vbKeyEscape Then
  255. Timer2.Enabled = Not Timer2.Enabled
  256. Timer1.Enabled = Not Timer1.Enabled
  257. End If
  258. End Sub
  259.  
  260. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  261. 'Just only allow the player to fire once with Control
  262. If KeyCode = vbKeyControl Then
  263. Keypressed = False
  264. End If
  265. End Sub
  266.  
  267. Private Sub Form_Load()
  268.  
  269. 'Set the height and width of the Form
  270. Me.Height = Screen.TwipsPerPixelX * 500
  271. Me.Width = Screen.TwipsPerPixelY * 600
  272. He = Me.ScaleHeight
  273. Wi = Me.ScaleWidth
  274.  
  275. 'PlayMusic "Background"
  276. 'Set the Gameplay variables
  277. Lives = 3
  278. Damage = 0
  279. CurrFire = 0
  280. ShipSpeed = 2
  281. BombNumber = 1
  282. FireQuality = 0
  283.  
  284. 'Set the ship position at the centre and States
  285. ShipX = Me.ScaleWidth \ 2 - 38
  286. ShipY = Me.ScaleHeight - picShip.Height
  287. sState = 0
  288. DrawShip Me.hdc, ShipX, ShipY, 3
  289.  
  290. 'Pass all the keydown events to Form
  291. Me.KeyPreview = True
  292.  
  293. 'Create New Instance of Classes
  294. Set Fire = New Weapon
  295. Set Asteroid = New CAsteroids
  296. Set Explosion = New cCollision
  297. Set Goody = New cGoody
  298. DX.Initialize
  299. 'Asteroid.InitAsteroids
  300. 'Create a compatible bitmap and DC and avoid Flicker
  301. MemDc = CreateCompatibleDC(Me.hdc)
  302. MemBmp = CreateCompatibleBitmap(Me.hdc, Me.ScaleWidth, Me.ScaleHeight)
  303. DeleteObject SelectObject(MemDc, MemBmp)
  304. SetBkMode MemDc, 0
  305. SetTextColor MemDc, vbWhite
  306. Timer1.Enabled = True
  307. Timer2.Enabled = True
  308. End Sub
  309.  
  310. Private Sub Form_Unload(Cancel As Integer)
  311. Dim names As String
  312. 'Delete the DC and Bitmap
  313.     DeleteObject MemBmp
  314.     DeleteDC MemDc
  315. 'Destroy the instance of classes
  316.     Set Fire = Nothing
  317.     Set Asteroid = Nothing
  318.     Set Explosion = Nothing
  319.     Set Goody = Nothing
  320.     Set DX = Nothing
  321.     
  322.     If Score > Val(GetSetting("The Last Hope", "HS", "Score")) Then
  323.         names = InputBox("You made a High Score" & vbCrLf & "Enter Your Name" _
  324.         , "Congratulations")
  325.         If names <> "" Then
  326.             SaveSetting "The Last Hope", "HS", "Name", names
  327.             SaveSetting "The Last Hope", "HS", "Score", Score
  328.         End If
  329.     End If
  330. End
  331. End Sub
  332.  
  333. Private Sub DrawShip(Dc As Long, x As Integer, y As Integer, Index As Integer)
  334. 'We shall Draw the Ship only if it is not Destroyed
  335. 'Else we shall delay the time and display a new ship at Centre
  336. Dim Xcord As Integer, Ycord As Integer
  337. Static ShipDisplayDelay As Integer
  338.  
  339. If isShipDestroyed Then
  340.     ShipDisplayDelay = ShipDisplayDelay + 1
  341.         If ShipDisplayDelay > 60 Then
  342.             ShipX = Me.ScaleWidth \ 2 - 38
  343.             ShipY = Me.ScaleHeight - picShip.Height
  344.             sState = 0
  345.             ShipDisplayDelay = 0
  346.             isShipDestroyed = False
  347.         End If
  348.     Exit Sub
  349. End If
  350. 'The ship position in the picture is quite Odd so we shall use tricks to draw ship
  351. 'correctly
  352. If Index < 0 Then
  353. Xcord = (Index + 6) * 79
  354. Ycord = picShip.ScaleHeight \ 2
  355. Else
  356. Xcord = Index * 79
  357. Ycord = 0
  358. End If
  359. BitBlt Dc, x, y, 79, picMask.ScaleHeight \ 2, picMask.hdc, Xcord, Ycord, vbSrcAnd
  360. BitBlt Dc, x, y, 79, picShip.ScaleHeight \ 2, picShip.hdc, Xcord, Ycord, vbSrcPaint
  361. End Sub
  362.  
  363. Private Sub CheckForKeys()
  364. 'Actually I wanted the ship to fire as well as move simultaneously so I used both
  365. 'API and keydown seperately.
  366.  
  367. Static ShipState1 As Integer, ShipState2 As Integer
  368. 'The noKEys value is used to auto straighten the ship when movement keys are not
  369. 'pressed.
  370. Dim noKEys As Boolean
  371. Static TimeDelay As Integer
  372. noKEys = True
  373. If isShipDestroyed Then Exit Sub
  374.  
  375. If GetAsyncKeyState(vbKeyUp) Then
  376.     If ShipY > 0 Then ShipY = ShipY - ShipSpeed
  377.     noKEys = False
  378. End If
  379.  
  380. If GetAsyncKeyState(vbKeyDown) Then
  381.     If ShipY < (Me.ScaleHeight - picShip.ScaleHeight \ 2) Then ShipY = ShipY + ShipSpeed
  382.     noKEys = False
  383. End If
  384.  
  385. If GetAsyncKeyState(vbKeyRight) Then
  386.     If ShipX < (Me.ScaleWidth - 79) Then ShipX = ShipX + ShipSpeed
  387.     ShipState1 = ShipState1 + 2
  388.     If ShipState1 > 2 Then
  389.     If sState < 6 Then sState = sState + 1
  390.     ShipState1 = 0
  391.     End If
  392. noKEys = False
  393. End If
  394.  
  395. If GetAsyncKeyState(vbKeyLeft) Then
  396.     If ShipX > 0 Then ShipX = ShipX - ShipSpeed
  397.     ShipState2 = ShipState2 + 1
  398.     If ShipState2 > 2 Then
  399.     If sState > -5 Then sState = sState - 1
  400.     ShipState2 = 0
  401.     End If
  402.     noKEys = False
  403. End If
  404.  
  405. 'Check for Collisiom of Ship with Asteroid
  406. Dim Collision As New cCollision
  407.     Collision.CheckCollisionAS ShipX, ShipY
  408. If noKEys Then
  409.   TimeDelay = TimeDelay + 1
  410.     If TimeDelay > 5 And sState <> 0 Then
  411.         TimeDelay = 0
  412.         If sState < 0 Then sState = sState + 1
  413.         If sState > 0 Then sState = sState - 1
  414.     End If
  415. TimeDelay = TimeDelay + 1
  416. End If
  417. Set Collision = Nothing
  418. End Sub
  419.  
  420. Private Sub PaintItBlack(Dc As Long)
  421. 'Repaint the BackGround each Time.
  422. Dim hBrush As Long, blah As RECT
  423. hBrush = CreatePatternBrush(picBkGround.Picture)
  424. With blah
  425.     .Top = 0
  426.     .Left = 0
  427.     .Bottom = He
  428.     .Right = Wi
  429. End With
  430. FillRect Dc, blah, hBrush
  431. DeleteObject hBrush
  432.  
  433. 'Draw the lives in the Top Corner
  434. Dim i As Integer, Startpos As Integer
  435. Startpos = Me.ScaleWidth - (Lives - 1) * 20
  436. For i = 1 To Lives - 1
  437.     BitBlt MemDc, Startpos, 0, 20, 15, picLife.hdc, 0, 0, vbSrcCopy
  438.     Startpos = Startpos + 20
  439. Next
  440. If CheatOn Then SetTextColor MemDc, vbRed
  441. 'Draw Damage in Top Left
  442.     BitBlt MemDc, 0, 0, 4 * (20 - Damage), 8, picDamage.hdc, 0, 0, vbSrcCopy
  443.     TextOut MemDc, 10, 10, "Damage " & Damage & Chr(32), 9
  444.     TextOut MemDc, Me.ScaleWidth \ 2 - 20, 0, "Score " & Format(Score, "0000000"), 13
  445. 'Draw Bombnumbers
  446.     TextOut MemDc, Wi \ 2 - 10, 15, BombNumber & " Bombs Left", 12
  447. End Sub
  448.  
  449. Private Sub CopyStuffs()
  450. 'Copy all the stuffs of the Memory Dc into Our Form
  451. BitBlt Me.hdc, 0, 0, Me.ScaleWidth, Me.ScaleHeight, MemDc, 0, 0, vbSrcCopy
  452. End Sub
  453.  
  454. Private Sub CheckFires()
  455. 'CHeck and Update the State of Fires
  456. If CurrFire Then Fire.DOFire
  457. End Sub
  458.  
  459. Private Sub CheckAsteroids()
  460. 'Check and Update the State of Asteroids
  461. Asteroid.DoAsteroids
  462. End Sub
  463.  
  464. Private Sub CheckExplosion()
  465. 'Check and Update the State of Explosions
  466. If CurrKaboom Then Explosion.DoExplosion
  467. End Sub
  468.  
  469. Private Sub CheckGoody()
  470. 'Check if Extra Goodies are available or not
  471. If GoodyPresent Then Goody.DoGoody
  472. End Sub
  473.  
  474. Private Function TranslateColor(aColor As OLE_COLOR) As Long
  475. 'I don't quite know about this. I got it from elsewhere.
  476.     Dim newcolor As Long
  477.     OleTranslateColor aColor, Me.Palette, newcolor
  478.     TranslateColor = newcolor
  479. End Function
  480.  
  481. Private Sub Destroyall()
  482. 'If you Have Bomb left and you release it then Destroy all Current Asteroids
  483. 'But it won't provide you points
  484. Dim i As Integer
  485. For i = 1 To CurrAsteroid
  486. Explosion.DestroyAsteroid i
  487. Next
  488. BombNumber = BombNumber - 1
  489. End Sub
  490.  
  491. Private Sub Timer1_Timer()
  492. 'This is a secondary timer.
  493. 'It creates a new Asteroid at a regular interval and also decides the Goody Time
  494.             Timer1.Enabled = False
  495.             Timer2.Enabled = False
  496.             Asteroid.CreateAsteroid
  497.             Timer1.Enabled = True
  498.             Timer2.Enabled = True
  499.             TimeVal = TimeVal + 1
  500.             Me.Caption = GameTime - TimeVal & " seconds remaining"
  501.             If TimeVal = GameTime Then Winner
  502.             GoodyTime = GoodyTime + 1
  503. End Sub
  504.  
  505. Private Sub Timer2_Timer()
  506. 'This is the main timer that updates all contents in the screen
  507. 'I heard somewhere that a Loop is good than Timer but I was quite not sure
  508. 'If anybody wants to help then please help
  509. If GameOver Then
  510. MsgBox "Game over"
  511. End
  512. End If
  513. PaintItBlack MemDc
  514.             DrawShip MemDc, ShipX, ShipY, sState
  515.             CheckForKeys
  516.             CheckFires
  517.             CheckAsteroids
  518.             CheckExplosion
  519.             CheckGoody
  520.             CopyStuffs
  521. End Sub
  522.  
  523.